home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / win / pascal / bitview.exe / BITVIEW.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-05-30  |  9.0 KB  |  357 lines
  1. {**************************************************************************************
  2. *                                                                                     *
  3. *                             Module Name  :  BITVIEW.PAS                             *
  4. *                                    Type  :  PROGRAM                                 *
  5. *                                                                                     *
  6. **************************************************************************************}
  7.  
  8. program Bitview;
  9.  
  10.  
  11. {$R BITVIEW.RES}
  12.  
  13.  
  14. uses
  15.   WObjects, WinTypes, WinProcs, WinDos, Strings, StdDlgs, Files;
  16.  
  17.  
  18. type
  19.   MDIBitmapApplication = object(TApplication)
  20.     procedure InitMainWindow; virtual;
  21.   end;
  22.  
  23.  
  24.   PMDIParentWindow = ^TMDIParentWindow;
  25.   TMDIParentWindow = object(TMDIWindow)
  26.     constructor Init(ATitle : PChar; AMenu : HMenu);
  27.  
  28.     procedure   MDIFileOpen(var Msg : TMessage);
  29.       virtual cm_First + cm_MDIFileOpen;
  30.  
  31.     procedure   WMQueryNewPalette(var Msg : TMessage);
  32.       virtual wm_First + wm_QueryNewPalette;
  33.     procedure   WMPaletteChanged(var Msg : TMessage);
  34.       virtual wm_First + wm_PaletteChanged;
  35.   end;
  36.  
  37.  
  38.   PMDIChildWindow = ^TMDIChildWindow;
  39.   TMDIChildWindow = object(TWindow)
  40.     ChildBitmap    : HBitmap;
  41.     ChildPalette   : hPalette;
  42.     BitmapWidth,
  43.     BitmapHeight   : LongInt;
  44.  
  45.     constructor Init(AParent : PWindowsObject; ATitle : PChar; BHandle : HBitmap;
  46.                      W, H : LongInt; MyPal : HPalette);
  47.     destructor  Done; virtual;
  48.  
  49.     function    GetClassName : Pchar ; virtual;
  50.     procedure   AdjustScroller;
  51.     procedure   GetWindowClass(var AWndClass : TWndClass);
  52.       virtual;
  53.     procedure   Paint(PaintDC : HDC; var PaintInfo : TPaintStruct);
  54.       virtual;
  55.  
  56.     procedure   WMSize(var Msg : TMessage);
  57.       virtual wm_First + wm_Size;
  58.     procedure   WMQueryNewPalette(var Msg : TMessage);
  59.       virtual wm_First + wm_QueryNewPalette;
  60.     procedure   WMPaletteChanged(var Msg : TMessage);
  61.       virtual wm_First + wm_PaletteChanged;
  62.     procedure   WMMDIActivate(var Msg : TMessage);
  63.       virtual wm_First + wm_MDIActivate;
  64.   end;
  65.  
  66.  
  67.  
  68.  
  69. { This constructor centers the program within the current workspace }
  70.  
  71. constructor TMDIParentWindow.Init(ATitle : PChar; AMenu : HMenu);
  72. begin
  73.   TMDIWindow.Init(ATitle, AMenu);
  74.   with Attr do
  75.   begin
  76.     X := GetSystemMetrics(sm_CXScreen) div 8;
  77.     Y := GetSystemMetrics(sm_CYScreen) div 8;
  78.     W := X * 6;
  79.     H := Y * 6;
  80.   end;
  81. end;
  82.  
  83.  
  84.  
  85.  
  86. { This procedure opens up a BITMAP file. Currently works with compressed and compressed
  87.   files. There is no logic to contend with corrupted files, though. }
  88.  
  89. procedure TMDIParentWindow.MDIFileOpen(var Msg : TMessage);
  90. var
  91.   FileName : TFilename;
  92.   Bitmap   : HBitmap;
  93.   Palette  : hPalette;
  94.   Width,
  95.   Height   : LongInt;
  96.   hPal     : hPalette;
  97.  
  98. begin
  99.   if CanClose then
  100.   begin
  101.     FileName[0] := #0;
  102.     Bitmap  := 0;
  103.     Palette := 0;
  104.     if FileDialog(HWindow, FileName, False) then
  105.     begin
  106.       SetCursor(LoadCursor(0, idc_Wait));
  107.       Bitmap := LoadBitmap(FileName, HWindow, Width, Height, Palette);
  108.       SetCursor(LoadCursor(0, idc_Arrow));
  109.       if (Bitmap = 0) then
  110.         MessageBox(HWindow, 'File is not a BITMAP', 'Error',
  111.           mb_IconExclamation or mb_ok)
  112.       else
  113.       begin
  114.         Application^.MakeWindow(New(PMDIChildWindow,
  115.                                 Init(@Self, FileName, Bitmap, Width, Height, Palette)));
  116.       end;
  117.     end;
  118.   end;
  119. end;
  120.  
  121.  
  122.  
  123.  
  124. { This procedure is here because Windows only sends QUERYNEWPALETTE messages to the Appli-
  125.   cations in use, NOT their MDI windows. }
  126.  
  127. procedure TMDIParentWindow.WMQueryNewPalette(var Msg : TMessage);
  128. var
  129.   CurrentMDIActiveChild : hWnd;
  130.   MDIClientWindow       : hWnd;
  131.  
  132. begin
  133.   MDIClientWindow := ClientWnd^.hWindow;
  134.  
  135.   CurrentMDIActiveChild := SendMessage (MDIClientWindow, WM_MDIGETACTIVE, 0, 0);
  136.   if (CurrentMDIActiveChild <> 0) then
  137.     SendMessage(CurrentMDIActiveChild, WM_QUERYNEWPALETTE, MDIClientWindow, 0);
  138. end;
  139.  
  140.  
  141.  
  142.  
  143. { This procedure is here because Windows only sends PALETTECHANGED messages to the Appli-
  144.   cations in use, NOT their MDI windows. }
  145.  
  146. procedure TMDIParentWindow.WMPaletteChanged(var Msg : TMessage);
  147. var
  148.   MDIClientWindow             : hWnd;
  149.   MDIChildWindow              : hWnd;
  150.   CurrentMDIActiveChildWindow : hWnd;
  151.  
  152. begin
  153.   MDIClientWindow := GetWindow(hWindow, GW_CHILD);
  154.   MDIChildWindow := GetWindow(MDIClientWindow, GW_CHILD);
  155.  
  156.   if (MDIChildWindow <> 0) then
  157.   begin
  158.     CurrentMDIActiveChildWindow := SendMessage (MDIClientWindow, WM_MDIGETACTIVE, 0, 0);
  159.     repeat
  160.       if not (MDIChildWindow = CurrentMDIActiveChildWindow) then
  161.         SendMessage(MDIChildWindow, WM_PALETTECHANGED, Msg.wParam, Msg.lParam);
  162.       MDIChildWindow := GetNextWindow(MDIChildWindow, GW_HWNDNEXT);
  163.     until (MDIChildWindow = 0);
  164.   end;
  165. end;
  166.  
  167.  
  168.  
  169.  
  170. { ***************** End App Window Methods, now Child methods ***************************** }
  171.  
  172.  
  173.  
  174.  
  175. constructor TMDIChildWindow.Init(AParent : PWindowsObject; ATitle : PChar; BHandle : HBitmap;
  176.                                  W, H : LongInt; MyPal : HPalette);
  177. begin
  178.   TWindow.Init(AParent, ATitle);
  179.   Attr.Style   := Attr.Style or ws_VScroll or ws_HScroll;
  180.   ChildBitmap  := BHandle;
  181.   ChildPalette := MyPal;
  182.   BitmapWidth  := W;
  183.   bitmapHeight := H;
  184.   Scroller := New(PScroller, Init(@Self, 1, 1, 200, 200));
  185.   Scroller^.TrackMode := False;
  186.   Scroller^.AutoMode  := False;
  187. end;
  188.  
  189.  
  190.  
  191.  
  192. destructor TMDIChildWindow.Done;
  193. begin
  194.   if (ChildBitmap <> 0) then
  195.     DeleteObject(ChildBitmap);
  196.   if (ChildPalette <> 0) then
  197.     DeleteObject(ChildPalette);
  198.   TWindow.Done;
  199. end;
  200.  
  201.  
  202.  
  203.  
  204. { This procedure picks out an ICON to use when minimized }
  205.  
  206. procedure TMDIChildWindow.GetWindowClass(var AWndClass : TWndClass);
  207. begin
  208.   TWindow.GetWindowClass(AWndClass);
  209.   AWndClass.HIcon := LoadIcon(HInstance, 'ICON_1');
  210. end;
  211.  
  212.  
  213.  
  214.  
  215. function TMDIChildWindow.GetClassName : PChar;
  216. begin
  217.   GetClassName := 'MDIChild';
  218. end;
  219.  
  220.  
  221.  
  222.  
  223. { This procedure is called only from the APP, not Windows. }
  224.  
  225. procedure TMDIChildWindow.WMQueryNewPalette(var Msg : TMessage);
  226. var
  227.   PalDC                 : HDC;
  228.   NumberOfChangedColors : Word;
  229.   MDIClientWindow       : hWnd;
  230.   hOldPal               : hPalette;
  231.  
  232. begin
  233.   MDIClientWindow := GetParent(hWindow);
  234.   PalDC := GetDC(MDIClientWindow);
  235.   hOldPal := SelectPalette(PalDC, ChildPalette, False);
  236.   NumberOfChangedColors := RealizePalette(PalDC);
  237.   if (NumberOfChangedColors > 0) then
  238.     InvalidateRect(hWindow, nil, False);
  239.   if (hOldPal <> 0) then
  240.     SelectPalette(PalDC, hOldPal, False);
  241.   ReleaseDC(MDIClientWindow,PalDC);
  242. end;
  243.  
  244.  
  245.  
  246.  
  247. { This procedure is called only from the APP, not Windows. }
  248.  
  249. procedure TMDIChildWindow.WMPaletteChanged(var Msg : TMessage);
  250. var
  251.   PalDC : HDC;
  252.   MDIPalette : hPalette;
  253.   hOldPal : hPalette;
  254.  
  255. begin
  256.   if ((ChildPalette <> 0) and (ChildBitmap <> 0)) then
  257.   begin
  258.     PalDC := GetDC(hWindow);
  259.     hOldPal := SelectPalette(PalDC, ChildPalette, True);
  260.     RealizePalette(PalDC);
  261.     UpdateColors(PalDC);
  262.     if (hOldPal > 0) then
  263.       SelectPalette(PalDC, hOldPal, False);
  264.     ReleaseDC(hWindow,PalDC);
  265.   end
  266. end;
  267.  
  268.  
  269.  
  270.  
  271. { This procedure is needed to tell all other Child windows that this window is taking the
  272.   palette }
  273.  
  274. procedure TMDIChildWindow.WMMDIActivate(var Msg : TMessage);
  275. var
  276.   MDIClientWindow : hWnd;
  277.   MDIParentWindow : hWnd;
  278.  
  279. begin
  280.   if (Msg.wParam = 1) then
  281.   begin
  282.     MDIClientWindow := GetParent(hWindow);
  283.     MDIParentWindow := GetParent(MDIClientWindow);
  284.     SendMessage (MDIParentWindow, WM_QUERYNEWPALETTE, MDIClientWindow, 0);
  285.   end;
  286. end;
  287.  
  288.  
  289.  
  290.  
  291. procedure TMDIChildWindow.Adjustscroller;
  292. var
  293.   ClientRect : TRect;
  294.  
  295. begin
  296.   GetClientRect(hWindow, ClientRect);
  297.   with ClientRect do
  298.     Scroller^.SetRange((BitmapWidth - (Right - Left)), (BitmapHeight - (Bottom - Top)));
  299.   InvalidateRect(hWindow, nil, False);
  300. end;
  301.  
  302.  
  303.  
  304.  
  305. procedure TMDIChildWindow.WMSize(var Msg : TMessage);
  306. begin
  307.   TWindow.WMSize(Msg);
  308.   if not (Msg.WParam = sizeIconic) then
  309.     AdjustScroller;
  310. end;
  311.  
  312.  
  313.  
  314.  
  315. procedure TMDIChildWindow.Paint(PaintDC : HDC; var PaintInfo : TPaintStruct);
  316. var
  317.   MemDC            : HDC;
  318.   Image, OldBitmap : HBitmap;
  319.   W,  H            : LongInt;
  320.  
  321. begin
  322.   Image := ChildBitmap;
  323.   W     := BitmapWidth;
  324.   H     := BitmapHeight;
  325.   if (Image <> 0) then
  326.   begin
  327.     MemDC := CreateCompatibleDC(PaintDC);
  328.     OldBitmap := SelectObject(MemDC, Image);
  329.     SelectPalette(PaintDC, ChildPalette, True);
  330.     SelectPalette(MemDC, ChildPalette, True);
  331.     BitBlt(PaintDC, 0, 0, W, H, MemDC, 0, 0, SRCCopy);
  332.     SelectObject(MemDC, OldBitmap);
  333.     DeleteDC(MemDC);
  334.   end;
  335. end;
  336.  
  337.  
  338.  
  339.  
  340. procedure MDIBitmapApplication.InitMainWindow;
  341. begin
  342.   MainWindow := New(PMDIParentWindow, Init('MDI Bitmap Viewer 1.00',
  343.                     LoadMenu(HInstance, 'MDIMenu')));
  344. end;
  345.  
  346.  
  347.  
  348.  
  349. var
  350.   MDIBitmapApp: MDIBitmapApplication;
  351.  
  352. begin
  353.   MDIBitmapApp.Init('MDI Bitmap Viewer 1.00');
  354.   MDIBitmapApp.Run;
  355.   MDIBitmapApp.Done;
  356. end.
  357.